home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / calrpak.bas < prev    next >
Encoding:
BASIC Source File  |  1985-06-03  |  1.4 KB  |  39 lines
  1. 1  '***********************************************************************
  2. 2  '* CALR-PAK: a program to reduce the size of the RBBS-PC CALLERS file. *
  3. 3  '*                                                                     *
  4. 4  '* (c)1984 by Read Gilgen     This program may be copied and used free *
  5. 5  '*    of charge provided that this notice is not changed or bypassed.  *
  6. 6  '***********************************************************************
  7. 7  '
  8. 20 CLS:LOCATE 13,36:PRINT "CALR-PAK"
  9. 22 LOCATE 15,17:PRINT "Program to Reduce Size of RBBS-PC CALLERS file"
  10. 24 LOCATE 16,29:PRINT "(c)1984 by Read Gilgen"
  11. 26 FOR PAUSE=1 TO 2000:NEXT
  12. 50 CLS:KEY OFF
  13. 100 OPEN "R",#1,"callers",64:FIELD #1, 64 AS INFO$
  14. 105 LOCATE 25,1:PRINT "SPACE to continue, <CR> to save records displayed so far.";
  15. 106 LOCATE 1,1
  16. 110 UDX=LOF(1)/64
  17. 111 RCDS = 1
  18. 115 FOR LOOP=UDX TO 1 STEP -1
  19. 120 GET #1,LOOP
  20. 130 PRINT INFO$;
  21. 140 PROC$=INPUT$(1)
  22. 145 IF PROC$=CHR$(13) THEN 500
  23. 146 RCDS = RCDS +1
  24. 150 NEXT
  25. 500 CLOSE:CLS
  26. 510 OPEN "R",#1,"callers",64:FIELD #1, 64 AS INFO$
  27. 520 OPEN "R",#2,"callers.new",64:FIELD #2, 64 AS SAVIT$
  28. 530 FOR LOOP =((UDX-RCDS)+1) TO UDX
  29. 532   GET #1, LOOP
  30. 534   IF LEFT$(INFO$,10)="          " THEN GOTO 570
  31. 535 PRINT INFO$
  32. 540   LSET SAVIT$=INFO$
  33. 550   PUT #2
  34. 570 NEXT
  35. 580 CLOSE
  36. 600  ' CALR-PAK   (c) 1984 by Read Gilgen
  37. O 570
  38. 535 PRINT INFO$
  39. 540   LSET SAVIT$=INFO$